home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0116_Detecting $G+ Compiler Directive.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  4KB  |  165 lines
  1. (*
  2. > I have now added the {$IFOPT G+} to most of my current sources, but I
  3. > would like default detection code in my libraries (often used TPUs)
  4. > Even if my TPUs are compiled in G- (which they always are, because
  5. > I update them with TPC from a batch file), but if my 'main' source
  6. > files are accidentally G+ I would like that detected by my library
  7. > code.
  8. *)
  9.  
  10. {$X+}{<<< Need this and strings unit }
  11. {===========================================================================
  12.  Copyrighted by Alfons Hoogervorst 1994 AD.
  13.  Well. Ok. It's dumped in the public domain.
  14.  ==========================================================================}
  15.  
  16. program Test8086;
  17.  
  18. uses
  19.   WinCrt, Strings;
  20.  
  21. const
  22.   { My firstname expressed in bytes, I guess. Use same bytes if possible
  23.     to overcome the byte ordering on PC's }
  24.   SEARCHID = $A2A2A2A2;
  25.   SEARCHBYTE = Byte(SEARCHID); { LoByte }
  26.   PUSHINT  = 2;
  27.  
  28.  
  29. procedure CallInOne(int: Integer);
  30. begin
  31.   { So I return }
  32. end;
  33.  
  34.  
  35. procedure CheckThisOut;
  36. begin
  37.   asm
  38.     jmp @Continue
  39.     dd SEARCHID                 { Bytes we're looking for }
  40.   @continue:
  41.   end;
  42.   { if G+:  push 0x02
  43.     else  mov ax,02;  push ax
  44.   }
  45.   CallInOne(PUSHINT)
  46. end;
  47.  
  48. type
  49.   TGOption = (Error, Goff, Gon);
  50.  
  51. function IsOptionGOn: TGOption;
  52. type
  53.   PDword = ^Longint;
  54. var
  55.   Opcodes: PChar;
  56.   i: Integer; { Say 50 bytes }
  57. begin
  58.   IsOptionGOn := Error;
  59.   OpCodes := PChar(@CheckThisOut);
  60.  
  61.   { Find our ID }
  62.   for i := 0 to 49 do { search some 50 bytes, must be enough }
  63.   begin
  64.     if PDword(OpCodes)^ = SEARCHID then
  65.     begin { Found our bytes }
  66.       OpCodes := OpCodes + sizeof(Longint); { Next instruction }
  67.  
  68.       { Check if it's PUSH PUSHINT instruction }
  69.       if (OpCodes^ = #$6A) and ((OpCodes+1)^ = Char(PUSHINT)) then
  70.         IsOptionGOn := Gon
  71.       else IsOptionGOn := Goff;
  72.       exit
  73.     end;
  74.     OpCodes := OpCodes + 1 { Try next }
  75.   end;
  76. end;
  77.  
  78. begin
  79.   WriteLn('I Call You Call Me? Ok!');
  80.  
  81.   case IsOptionGOn of
  82.     Error:
  83.     begin
  84.       WriteLn('Error... Borland Pascal code generation changed dramatically');
  85.       WriteLn('The world is collapsing, all programs have become
  86. incompatible');      WriteLn('The Horror of It! Get me some assembler and I''ll
  87. fix it!')    end;
  88.     Gon:
  89.     begin
  90.       WriteLn('''t Was On');
  91.     end;
  92.     Goff:
  93.     begin
  94.       WriteLn('''t Was Off');
  95.     end;
  96.   end;
  97. end.
  98.  
  99. (*
  100. What am I doing here? Just looking for a push instruction. If {$G} on
  101. constants are pushed with an immediate push instruction. Sounds
  102. dificult? Well, just forget it, implement these functions in a unit
  103. and you have your long-awaited test function.
  104.  
  105. I have some notes on my own code. If you're using my check-80X86 function
  106. NEVER do the following things:
  107. *)
  108.  
  109. if (OptionGOn = Goff) then
  110. begin
  111.   WriteLn('This code is compiled with $G+');
  112.   Halt(2) {<<<<< PROBLEMS!!! }
  113. end;
  114. (*
  115. Why?
  116.  
  117. If $G has been enabled you'll get:
  118.  
  119. push 2
  120. call far HALT
  121.  
  122. And (as you noted) an 808X does not accept this.
  123.  
  124. Instead use this:
  125. *)
  126.  
  127. if (OptionGOn = GOn) then
  128. begin
  129.   WriteLn('Option $G enabled message');
  130.   Halt(Integer(OptionGOn)) { Or pass a variable }
  131. end;
  132.  
  133. (*
  134. In plain words: after checking the G-state with my function, don't call a
  135. function with constant parameters. Always pass variables/function-results as
  136. parameters.
  137. This is not "portable":
  138. *)
  139.  
  140. const
  141.   ERROR_GERROR  = 2;
  142.   ANOTHER_CONST = 3;
  143.  
  144. if { my test } then
  145. begin
  146.   IWantToExitRightNow(ERROR_GERROR, ANOTHER_CONST, 4, 6, 7);
  147.  
  148. end;
  149.  
  150. { Instead try this: }
  151.  
  152. if { my test } then
  153. begin
  154.   IWantToExitRightNow(VarIndicatingError, VarForAnotherConst,
  155.      FunctionCall4, FunctionCall6, VarContaining7)
  156.  
  157. end;
  158.  
  159. {
  160. This is _only_ necessary in the "code" block immediately following my
  161. function, not in your other code. By the way: I have written a unit for
  162. detecting this $G-state. It's partly written in asm. This unit does not
  163. require the "use" of other units.
  164. }
  165.